1410 IF DEVICE$="SCRN:" THEN ANSWER$="" ELSE LINE INPUT "Regular or wide listing <Regular>: ";ANSWER$
1420 IF ANSWER$="" THEN ANSWER$="R" ELSE ANSWER$=FNUPSHIFT$(ANSWER$)
1430 IF ANSWER$="R" THEN WIDENESS%=80 ELSE IF ANSWER$="W" THEN WIDENESS%=132 ELSE PRINT "Please answer 'Regular' or 'Wide', only!":GOTO 1400
1440 IF ANSWER$="W" THEN WIDENESS%=132
1490 IF DEVICE$="LPT1:" THEN WIDTH #2,WIDENESS%
1500 NONE%=0:RESTORE:READ LISTDATA$
1510 WHILE (LISTDATA$<>"INIT NONE"):READ LISTDATA$:WEND:READ LISTDATA$
1520 WHILE (LISTDATA$<>"END NONE")
1530 NONE$(NONE%)=LISTDATA$:NONE%=NONE%+1
1540 READ LISTDATA$
1550 WEND:NONE%=NONE%-1
1600 FD%=0:RESTORE:READ LISTDATA$
1610 WHILE (LISTDATA$<>"INIT FD"):READ LISTDATA$:WEND:READ LISTDATA$
1620 WHILE (LISTDATA$<>"END FD")
1630 FD$(FD%)=LISTDATA$:FD%=FD%+1
1640 READ LISTDATA$
1650 WEND:FD%=FD%-1
1700 FE%=0:RESTORE:READ LISTDATA$
1710 WHILE (LISTDATA$<>"INIT FE"):READ LISTDATA$:WEND:READ LISTDATA$
1720 WHILE (LISTDATA$<>"END FE")
1730 FE$(FE%)=LISTDATA$:FE%=FE%+1
1740 READ LISTDATA$
1750 WEND:FE%=FE%-1
1800 FF%=0:RESTORE:READ LISTDATA$
1810 WHILE (LISTDATA$<>"INIT FF"):READ LISTDATA$:WEND:READ LISTDATA$
1820 WHILE (LISTDATA$<>"END FF")
1830 FF$(FF%)=LISTDATA$:FF%=FF%+1
1840 READ LISTDATA$
1850 WEND:FF%=FF%-1
1900 ' Set up heading
1910 HEADING$=FNC$(WIDENESS%,"Listing for "+FILENAME$)
1990 GOSUB 17000 'print first header
3000 ' Read First Three Characters of Basic Program File
3010 GOSUB 14000
3020 IF C%<>255 THEN PRINT "Not a tokenized program file!":GOTO 9999
3030 GOSUB 11000 'get first offset address
3100 ' Get all Variable Name and Line Number References
3120 WHILE ADR<>0 'ADR=0 if end of program
3140 GOSUB 14000:LINE.NO=C%
3150 GOSUB 14000:LINE.NO=(CSNG(C%)*256)+LINE.NO
3160 OUTLINE$="":TEMP$=STR$(LINE.NO):GOSUB 18500
3170 OUTLINE$=LEFT$(OUTLINE$+SPACE$(INDENT%),INDENT%) 'position line num and margin
3180 GOSUB 14000 'get ready for the line
3190 WHILE C%=32:GOSUB 14000:WEND
3200 IFDENT%=0:IFFLAG%=0 'IF indenters
3210 IFED%=0:THENED%=0 'IF/THEN counters
3390 FIRST%=TRUE% 'haven't gotten anything yet
3400 WHILE C%<>0 'C%=0 if end of line
3410 T1%=C% 'save first token
3500 IF C%<255 THEN 3600 'not in FF array
3510 GOSUB 14000:TOKEN%=C%-128 'get index into array
3520 IF TOKEN%<0 OR TOKEN%>FF% THEN TOKEN$=FNKNOWN$(TOKEN%+128) ELSE TOKEN$=FF$(TOKEN%) 'get token to print
3590 GOTO 4000 'handle special tokens
3600 IF C%<254 THEN 3700 'not in FE array
3610 GOSUB 14000:TOKEN%=C%-128 'get index into array
3620 IF TOKEN%<0 OR TOKEN%>FE% THEN TOKEN$=FNKNOWN$(TOKEN%+128) ELSE TOKEN$=FE$(TOKEN%) 'get token to print
3690 GOTO 4000 'handle special tokens
3700 IF C%<253 THEN 3800 'not in FD array
3710 GOSUB 14000:TOKEN%=C%-128 'get index into array
3720 IF TOKEN%<0 OR TOKEN%>FD% THEN TOKEN$=FNKNOWN$(TOKEN%+128) ELSE TOKEN$=FD$(TOKEN%) 'get token to print
3790 GOTO 4000 'handle special tokens
3800 IF C%<128 THEN 4500 'not in NONE array
3810 TOKEN%=C%-128 'get index into array
3820 IF TOKEN%<0 OR TOKEN%>NONE% THEN TOKEN$=FNKNOWN$(TOKEN%+128) ELSE TOKEN$=NONE$(TOKEN%) 'get token to print
3890 GOTO 4000 'handle special tokens
4000 'Got the token, now process it
4001 'PRINT "*****4001 Token '"TOKEN$"' has value "T1%;:IF T1%=C% THEN PRINT ELSE PRINT " "C%
4010 IF (T1%=205) OR (T1%=137 AND IFED%-THENED%>0) THEN GOSUB 19000:OUTLINE$=SPACE$(INDENT%+IFDENT%)+TOKEN$:IFDENT%=IFDENT%+5:IFFLAG%=IFFLAG% OR 2^THENED%:THENED%=THENED%+1:GOTO 4890 'THEN or GOTO used as THEN
4030 IF T1%=131 OR T1%=178 THEN INDENT%=INDENT%-3:OUTLINE$=LEFT$(OUTLINE$,LEN(OUTLINE$)-3) 'unindent after NEXT or WEND statements
4100 OUTLINE$=OUTLINE$+TOKEN$ 'output the token
4110 IF T1%<>C% THEN 4890
4120 IF C%=132 THEN WHILE (C%<>0 AND C%<>58):GOSUB 14000:OUTLINE$=OUTLINE$+CHR$(C%):WEND:GOTO 4900 'DATA statement
4130 IF C%=130 OR C%=177 THEN INDENT%=INDENT%+3:IF C%<>177 THEN 4890 ELSE GOSUB 14000:GOTO 4890 'indent after FOR or WHILE statements
4140 IF C%=139 THEN IFDENT%=IFDENT%+3:IFED%=IFED%+1:GOTO 4890 'increment IF indent
4490 GOTO 4890
4500 IF (C%>10 AND C%<14) OR C%=28 THEN CNT%=2:GOSUB 18000:TEMP$=STR$(CVI(TEMP$)):GOSUB 18500:GOTO 4890 'two-byte constant
4510 IF C%=14 THEN GOSUB 13000:GOTO 4900'line number
4520 IF C%=15 THEN GOSUB 14000:TEMP$=STR$(C%):GOSUB 18500:GOTO 4890
4530 IF (C%>16 AND C%<27) THEN TEMP$=STR$(C%-17):GOSUB 18500:GOTO 4890
4540 IF C%=29 THEN CNT%=4:GOSUB 18000:TEMP$=STR$(CVS(TEMP$)):GOSUB 18500:GOTO 4890 'four-byte constant
4550 IF C%=31 THEN CNT%=8:GOSUB 18000:TEMP$=STR$(CVD(TEMP$)):GOSUB 18500:GOTO 4890 'eight-byte constant
4560 IF C%=32 THEN BLANKS%=0:WHILE C%=32:BLANKS%=BLANKS%+1:GOSUB 14000:WEND:IF C%<>58 THEN OUTLINE$=OUTLINE$+SPACE$(BLANKS%):GOTO 4900 ELSE GOSUB 10000:GOTO 4900 'blanks
4570 IF C%=34 THEN OUTLINE$=OUTLINE$+CHR$(C%):GOSUB 14000:WHILE (C%<>34 AND C%<>0):OUTLINE$=OUTLINE$+CHR$(C%):GOSUB 14000:WEND:IF C%=0 THEN 4900 ELSE OUTLINE$=OUTLINE$+CHR$(C%):GOTO 4890 'print string constant
4580 IF C%=58 THEN GOSUB 10000:GOTO 4900
4590 IF (C%>64 AND C%<91) THEN GOSUB 12000:GOTO 4900
4790 OUTLINE$=OUTLINE$+CHR$(C%):GOTO 4890
4800 OUTLINE$=OUTLINE$+"?"+FNKNOWN$(C%)+"?"
4890 GOSUB 14000
4900 FIRST%=FALSE%
4910 WEND
4920 GOSUB 19000 'dump out last line
4980 GOSUB 11000 'begin new line
4990 WEND:PRINT #2,
9800 IF DEVICE$<>"SCRN:" THEN FOR I%=LINES% TO 4 STEP -1:PRINT #2,:NEXT I%
9820 IF DEVICE$="SCRN:" THEN PRINT #2, ELSE PRINT #2,CHR$(12)
9999 IF DEVICE$="SCRN:" THEN 32767 ELSE LOCATE 22,1:PRINT "All done!":GOTO 32767
10000 ' Special cases of ":"
10010 GOSUB 14000
10020 IF C%<>161 THEN 10050 ELSE GOSUB 19000:C%=7
10030 C%=C%-1:IF C%<0 THEN STOP ELSE IF (IFFLAG% AND 2^C%)=0 THEN 10030 ELSE IFFLAG%=IFFLAG% XOR (2^C%):C%=C%+1:IF C%<>THENED% THEN IFDENT%=C%*8:THENED%=C%:IFED%=C% 'Whew! this should take care of any IF/THEN/ELSE in existence
16090 IF DEVICE$="SCRN:" THEN PRINT #2, ELSE PRINT #2,CHR$(12)
17000 ' Print the header
17010 PRINT #2,:PRINT #2,
17020 PRINT #2,TIME$;TAB(WIDENESS%-12);DATE$
17030 PRINT #2,
17040 PRINT #2,HEADING$
17050 PRINT #2,:PRINT #2,
17080 PAGES%=PAGES%+1:LINES%=LONGNESS%-7
17090 RETURN
18000 ' Put a number CNT% bytes long into TEMP$
18010 TEMP$="":FOR TEMP%=1 TO CNT%
18020 GOSUB 14000:TEMP$=TEMP$+CHR$(C%)
18030 NEXT TEMP%
18090 RETURN
18500 ' Chop blank off front of TEMP$
18510 IF ASC(TEMP$)=32 THEN TEMP$=RIGHT$(TEMP$,LEN(TEMP$)-1)
18580 OUTLINE$=OUTLINE$+TEMP$
18590 RETURN
19000 ' Print OUTLINE$ to the device
19010 FIRST%=TRUE%
19020 IF NOT FIRST% THEN OUTLINE$=SPACE$(INDENT%+5)+OUTLINE$
19030 OUTLEN%=LEN(OUTLINE$):IF OUTLEN%<81 THEN PRINT #2,OUTLINE$:LINES%=LINES%-1 ELSE PRINT #2,LEFT$(OUTLINE$,79):OUTLINE$=RIGHT$(OUTLINE$,OUTLEN%-79):LINES%=LINES%-1:FIRST%=FALSE%:GOTO 19020 'print the line
19070 IF LINES%<6 THEN GOSUB 16000 'go to new page
19080 OUTLINE$="" 'blank out the line
19090 RETURN
30000 ' E r r o r T r a p s
31000 IF ERL=1210 THEN LOCATE 9,1:PRINT "That file doesn't exist!":RESUME 1100